home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qbfunc.arc / QBFUNC.BAS
Encoding:
BASIC Source File  |  1987-03-08  |  17.8 KB  |  777 lines
  1. '***************************************************************************
  2. '* QB_LIB1.BAS  version  1.02       Last: 02-11-1987                       *
  3. '*                                                                         *
  4. '* Author: Ronald G. Earley                                                *
  5. '*                                                                         *
  6. '* These routines are free to the public - use how ever you wish!          *
  7. '***************************************************************************
  8. '                                                                          '
  9. ' version 1.01 (02-02-1987) added the following functions:                 '
  10. '               center.text()                                              '
  11. '               get.day()                                                  '
  12. '               real.time()                                                '
  13. '                                                                          '
  14. ' version 1.02 (02-05-1987) added the following functions:                 '
  15. '               bios.scroll ()                                             '
  16. '                                                                          '
  17. '--------------------------------------------------------------------------'
  18.  
  19. dim style%(4,10)        ' styles for window drwing
  20. dim m$(12)              ' month names
  21. dim days$(6)            ' day names
  22. dim m%(12)              ' number of days for each month
  23. dim in.regs%(7)         ' registers before bios call
  24. dim out.regs%(7)        ' registers after return of bios call
  25.  
  26. '============================================================================
  27.  
  28. SUB elapsed.time (s$,e$,m#) STATIC
  29.  
  30.     ' get starting, ending  minutes
  31.     s#=(val(left$(s$,2))*60)+val(mid$(s$,4,2))
  32.     e#=(val(left$(e$,2))*60)+val(mid$(e$,4,2))
  33.  
  34.     ' check if rollover
  35.     ' we can tell if s# > e#  i.e. 23:40:00 and 00:15:00
  36.     ' if so, add 1440 to e# (1440 = 24 * 60)
  37.  
  38.     if s#>e# then e#=e#+1440
  39.  
  40.     m#=e#-s#
  41.  
  42.     EXIT SUB
  43. END SUB
  44.  
  45. '============================================================================
  46.  
  47. SUB scan.string (a$,s$,c%,case.type%) STATIC
  48.  
  49.     a1$=a$
  50.     s1$=s$
  51.  
  52.     if (case.type%=0) then
  53.     call lower.to.upper (a1$)
  54.     call lower.to.upper (s1$)
  55.     end if
  56.  
  57.     c%=instr(1,a1$,s1$)
  58.  
  59.     EXIT SUB
  60. END SUB
  61.  
  62. '============================================================================
  63.  
  64. SUB month.name (month$,month%) STATIC
  65.     shared m$()
  66.  
  67.     m$(1)="January"         ' init month names
  68.     m$(2)="February"
  69.     m$(3)="March"
  70.     m$(4)="April"
  71.     m$(5)="May"
  72.     m$(6)="June"
  73.     m$(7)="July"
  74.     m$(8)="August"
  75.     m$(9)="September"
  76.     m$(10)="October"
  77.     m$(11)="November"
  78.     m$(12)="December"
  79.  
  80.     month$=m$(month%)
  81.  
  82.     EXIT SUB
  83. END SUB
  84.  
  85. '============================================================================
  86.  
  87. SUB days.after (a$,start.date$,days%) STATIC
  88.  
  89.     m%(1)=31
  90.     m%(2)=28
  91.     m%(3)=31
  92.     m%(4)=30
  93.     m%(5)=31
  94.     m%(6)=30
  95.     m%(7)=31
  96.     m%(8)=31
  97.     m%(9)=30
  98.     m%(10)=31
  99.     m%(11)=30
  100.     m%(12)=31
  101.  
  102.     ' check for leap year
  103.     year%=val(right$(date$,4))
  104.     if (((year% MOD 4)=0 and (year% MOD 100)<>0) or (year% MOD 400)=0) then
  105.     m%(2)=29
  106.     end if
  107.  
  108.     ' add days% onto date
  109.     sm%=val(left$(start.date$,2))
  110.     sd%=val(mid$(start.date$,4,2))
  111.     sy%=val(right$(start.date$,4))
  112.  
  113.     for x%=1 to days%
  114.     sd%=sd%+1
  115.     if (sd%>m%(sm%)) then
  116.         sm%=sm%+1
  117.     end if
  118.     if (sm%>12) then
  119.         sm%=1
  120.         sy%=sy%+1
  121.     end if
  122.     next x%
  123.  
  124.     ' form return date
  125.     sm$=str$(sm%):sm$=string$(2-len(sm$),"0")
  126.     sd$=str$(sd%):sd$=string$(2-len(sd$),"0")
  127.     sy$=str$(sy%):sy$=string$(4-len(sy$),"0")
  128.     a$=sm$+"-"+sd$+"-"+sy$
  129.  
  130.     EXIT SUB
  131. END SUB
  132.  
  133. '============================================================================
  134.  
  135. SUB parse.block (count%,parse$,l%(1),a$(1),drop%) STATIC
  136.  
  137.     start%=1
  138.     for x%=0 to count%
  139.     a$(x%)=mid$(parse$,start%,l%(x%))
  140.     if (drop%) then call drop.trailing.spaces (a$(x%))
  141.     start%=start%+l%(x%)
  142.     next x%
  143.  
  144.     EXIT SUB
  145. END SUB
  146.  
  147. '============================================================================
  148.  
  149. SUB remove.backspaces (a$) STATIC
  150.  
  151.     c%=len(a$)
  152.     start%=1
  153.     i%=instr(start%,a$,chr$(8))
  154.     while (i%)
  155.     a$=left$(a$,i%-2)+right$(a$,len(a$)-i%)
  156.     start%=i%
  157.     i%=instr(start%,a$,chr$(8))
  158.     wend
  159.  
  160.     EXIT SUB
  161. END SUB
  162.  
  163. '============================================================================
  164.  
  165. SUB remove.char (a$,c%) STATIC
  166.  
  167.     start%=1
  168.     i%=instr(start%,a$,chr$(c%))
  169.     while (i%)
  170.     a$=left$(a$,i%-1)+right$(a$,len(a$)-i%)
  171.     start%=i%
  172.     i%=instr(start%,a$,chr$(c%))
  173.     wend
  174.  
  175.     EXIT SUB
  176. END SUB
  177.  
  178. '============================================================================
  179.  
  180. SUB wait.for.carrier (modem.status.port%,c#) STATIC
  181.  
  182.     while (c#)
  183.     if (128 AND inp(modem.status.port%)) then EXIT SUB
  184.     c#=c#-1
  185.     wend
  186.  
  187.     EXIT SUB
  188. END SUB
  189.  
  190. '============================================================================
  191.  
  192. SUB check.carrier (modem.status.port%,flag%) STATIC
  193.  
  194.     flag%=inp(modem.status.port%) AND 128
  195.  
  196.     EXIT SUB
  197. END SUB
  198.  
  199. '============================================================================
  200.  
  201. SUB set.color (a%,b%,c%,d%,type%) STATIC
  202.  
  203.     if (type%=1) then
  204.     color a%,b%             ' take monochrome colors
  205.     elseif (type%=0) then
  206.     color c%,d%             ' take color colors
  207.     end if
  208.  
  209.     EXIT SUB
  210. END SUB
  211.  
  212. '============================================================================
  213.  
  214. SUB clear.kb.buffer STATIC
  215.  
  216.     def seg=0
  217.     poke 1050,peek(1052)
  218.     def seg
  219.  
  220.     EXIT SUB
  221. END SUB
  222.  
  223. '============================================================================
  224.  
  225. SUB lower.to.upper (x$) STATIC
  226.  
  227.     a%=len(x$)
  228.     for x%=1 to a%
  229.     c%=asc(mid$(x$,x%,1))
  230.         if (c%>96 and c%<123) then mid$(x$,x%,1)=chr$(c%-32)
  231.     next x%
  232.  
  233.     EXIT SUB
  234. END SUB
  235.  
  236. '============================================================================
  237.  
  238. SUB delay (x) STATIC
  239.  
  240.     for td=1 to x
  241.     if inkey$=chr$(27) then td=x+1
  242.     next td
  243.  
  244.     EXIT SUB
  245. END SUB
  246.  
  247. '============================================================================
  248.  
  249. SUB drop.trailing.spaces (x$) STATIC
  250.  
  251.     a%=len(x$)
  252.     for x%=a% to 1 step -1
  253.     if mid$(x$,x%,1)=chr$(32) then _
  254.     next x%
  255.     x$=left$(x$,x%)
  256.  
  257.     EXIT SUB
  258. END SUB
  259.  
  260. '============================================================================
  261.  
  262. SUB getinp (ypos%,xpos%,length%,csr%,cbuf%,cinp%,bsc%,lb%,ub%,retinp$,kb%,aret%,fg%,bg%) STATIC
  263.  
  264.     STATIC ncc%
  265.     kb%=0
  266.     
  267.     if ypos%>25 or ypos%<0 then EXIT SUB
  268.     if xpos%>80 or xpos%<0 then EXIT SUB
  269.     if length%<0 or length%>32767 then EXIT SUB
  270.     if cbuf% then call clear.kb.buffer
  271.     if cinp% then retinp$=""
  272.     if bsc%=0 then bsc%=32
  273.     if lb%<1 or lb%>255 then lb%=32
  274.     if ub%<1 or ub%>255 then ub%=122
  275.     if fg%<0 or fg%>31 then fg%=15
  276.     if bg%<0 or bg%>7 then bg%=0
  277.  
  278.     getkey:
  279.  
  280.     kb$=inkey$
  281.     ncc%=ncc%+1
  282.     if ncc%>300 then gosub blinkcursor
  283.     if len(kb$)=0 then goto getkey
  284.  
  285.     ' check for single scan code
  286.     while (len(kb$)=1)
  287.         loop%=1
  288.         kb%=asc(kb$)
  289.  
  290.         ' check for characters in input range
  291.         while ((kb%>=lb% and kb%<=ub%) and loop%=1 and len(retinp$)<length%)
  292.         if (ypos%>0 and ypos%<26 and xpos%>0 and xpos%<81) then
  293.         color fg%,bg%
  294.         locate ypos%,xpos%+len(retinp$):print kb$;
  295.         end if
  296.         retinp$=retinp$+kb$
  297.         if (aret%=1 and len(retinp$)=length%) then
  298.         kb%=13
  299.         goto finishup
  300.         end if
  301.         loop%=0
  302.     wend
  303.  
  304.     ' back space
  305.     while (kb%=8 and loop%=1)
  306.         while (len(retinp$)>0 and loop%=1)
  307.         color fg%,bg%
  308.         retinp$=left$(retinp$,len(retinp$)-1)
  309.         locate ypos%,xpos%+len(retinp$)+1
  310.  
  311.         if len(retinp$)=length%-1 then _
  312.             print " "; _
  313.         else _
  314.             print chr$(bsc%);
  315.  
  316.         if (csr%) then
  317.             locate ypos%,xpos%+len(retinp$)
  318.             print chr$(bsc%);
  319.         end if
  320.  
  321.         loop%=0
  322.         wend
  323.         loop%=0
  324.     wend
  325.  
  326.     ' enter, esc
  327.     if ((kb%=13 or kb%=27) and loop%=1) then
  328.         loop%=0
  329.         goto finishup
  330.     end if
  331.  
  332.     ' ctrl-a through ctrl-z
  333.     if ((kb%>0 and kb%<27) and loop%=1) then
  334.         loop%=0
  335.         goto finishup
  336.     end if
  337.  
  338.         kb$=""
  339.     wend
  340.  
  341.     ' check for extended code inputs
  342.     while (len(kb$)=2)
  343.         kb%=asc(right$(kb$,1))
  344.  
  345.     ' add 255 to kb% so we know it is an extended code
  346.     kb%=kb%+255
  347.     loop%=0
  348.     goto finishup
  349.     wend
  350.  
  351.     while (loop%)
  352.     call clear.kb.buffer
  353.     loop%=0
  354.     goto getkey
  355.     wend
  356.  
  357.     goto getkey
  358.  
  359.     blinkcursor:
  360.  
  361.     ncc%=0
  362.     if (csr%=0) then return
  363.     color 7,0
  364.     locate ypos%,xpos%+len(retinp$)
  365.  
  366.     if (blink%) then
  367.     blink%=0
  368.     else
  369.     blink%=1
  370.     end if
  371.  
  372.     if blink%=0 then _
  373.     print chr$(219);:return
  374.     if (blink%=1 and len(retinp$)=length%) then _
  375.     print " "; _
  376.     else _
  377.     print chr$(bsc%);
  378.     return
  379.  
  380.     finishup:
  381.  
  382.     blink%=0
  383.     gosub blinkcursor
  384.  
  385.     EXIT sub
  386. END SUB
  387.  
  388. '============================================================================
  389.  
  390. SUB get.display.type (type%) STATIC
  391.  
  392.     def seg=0
  393.     if (peek(&h410) AND &h30)=&h30 then
  394.     type%=1
  395.     else
  396.     type%=0
  397.     end if
  398.     def seg
  399.  
  400.     EXIT SUB
  401. END SUB
  402.  
  403. '============================================================================
  404.  
  405. SUB search.replace (search.string$,find$,replace$,case.type%,r.num%) STATIC
  406.  
  407.     ' check case
  408.     if (case.type%=0) then
  409.     call lower.to.upper (search.string$)
  410.     call lower.to.upper (find$)
  411.     end if
  412.  
  413.     c1%=0       ' current number of s/r
  414.     start%=1
  415.     char.ptr%=instr(start%,search.string$,find$)
  416.  
  417.     while (char.ptr%>0 and c1%<r.num%)
  418.     ' replace text
  419.     l$=left$(search.string$,char.ptr%-1)
  420.     r$=right$(search.string$,len(old$)-char.ptr%)
  421.     search.string$=l$+replace$+r$
  422.     ' set starting position and start search
  423.     start%=start%+len(replace$)
  424.     c1%=c1%+1
  425.     char.ptr%=instr(start%,search.string$,find$)
  426.     wend
  427.  
  428.     r.num%=c1%          ' set number of s/r on return
  429.  
  430.     EXIT SUB
  431. END SUB
  432.  
  433. '============================================================================
  434.  
  435. SUB draw.window (y1%,x1%,y2%,x2%,c1%,c2%,c3%,c4%,c5%,c6%,h$,s%,ac%,quick%,type%) STATIC
  436.  
  437.     shared style%()   ' array containing style information
  438.  
  439.     STATIC isfirst%
  440.     isheader%=0
  441.  
  442.     ' check monitor type - if monochrome, change colors to 15,0
  443.     if (type%) then
  444.     c1%=7:c2%=0
  445.     c3%=7:c4%=0
  446.     c5%=7:c6%=0
  447.     end if
  448.  
  449.     while (isfirst%=0)
  450.     for z%=1 to 4
  451.         for z1%=0 to 10
  452.         read style%(z%,z1%)
  453.         next z1%
  454.     next z%
  455.     isfirst%=1 ' set so routine won't be executed every call
  456.     wend
  457.  
  458.     ' data table for styles - ascii codes as follows:
  459.     ' upper-left,left header brace,left side (also right),lower-left,
  460.     ' bottom (middle,top) line,lower-right,right header brace,upper-right.
  461.     ' styles are numbered 1 - ? where 0 is user definable (ac%)
  462.  
  463.     data 201,204,186,200,205,188,185,187,0,0,0
  464.     data 218,195,179,192,196,217,180,191,0,0,0
  465.     data 213,198,179,212,205,190,181,184,0,0,0
  466.     data 214,199,186,211,196,189,182,183,0,0,0
  467.  
  468.     ' check bounds on passed parameters
  469.     if (y1%<1 or y1%>25 or y2%<1 or y2%>25 or y2%<y1%) then EXIT SUB
  470.     if (x1%<1 or x1%>80 or x2%<1 or x2%>80 or x2%<x1%) then EXIT SUB
  471.     if (c1%<0 or c1%>31) then c1%=7
  472.     if (c2%<0 or c2%>31) then c2%=0
  473.     if (c3%<0 or c3%>31) then c3%=7
  474.     if (c4%<0 or c4%>31) then c4%=0
  475.     if (c5%<0 or c5%>31) then c5%=7
  476.     if (c6%<0 or c6%>31) then c6%=0
  477.     if (s%<0 or s%>4)    then EXIT SUB
  478.     if (s%=0 and (ac%<0 or ac%>255)) then EXIT SUB
  479.  
  480.     loop%=1
  481.     while (loop% and s%=0)
  482.     for x%=0 to 10
  483.         style%(0,x%)=ac%
  484.     next x%
  485.     loop%=0
  486.     wend
  487.  
  488.     if len(h$)>0 then isheader%=1 ' if there is a header, set flag
  489.     dwidth%=x2%-x1%-1             ' display width (characters)
  490.  
  491.     ulc%=style%(s%,0)   ' upper-left corner
  492.     lhb%=style%(s%,1)   ' left header brace
  493.     lrs%=style%(s%,2)   ' left,right side
  494.     llc%=style%(s%,3)   ' lower-left corner
  495.     bmt%=style%(s%,4)   ' bottom,middle,top lines
  496.     lrc%=style%(s%,5)   ' lower-right corner
  497.     rhb%=style%(s%,6)   ' right header brace
  498.     urc%=style%(s%,7)   ' upper-right corner
  499.  
  500.     color c1%,c2%                               ' upper-left corner,top line,
  501.     locate y1%,x1%                              ' upper-right corner,left
  502.     print chr$(ulc%);string$(dwidth%,bmt%);chr$(urc%);
  503.  
  504.     loop%=1
  505.     while (isheader% and loop%)                 ' if a header exists
  506.     d%=dwidth%-len(h$)
  507.     d1%=d%
  508.     d%=int(d%/2)
  509.     if (d%*2)=d1% then d1%=d% else d1%=d%+1
  510.     locate y1%+1,x1%
  511.     color c1%,c2%:print chr$(lrs%);
  512.     color c5%,c6%:print space$(d%);h$;space$(d1%);
  513.     color c1%,c2%:print chr$(lrs%);
  514.     loop%=0
  515.     wend
  516.  
  517.     loop%=1
  518.     while (loop% and isheader%=0)
  519.     locate y1%+1,x1%
  520.     color c1%,c2%:print chr$(lrs%);
  521.     color c5%,c6%:print space$(dwidth%);
  522.     color c1%,c2%:print chr$(lrs%);
  523.     loop%=0
  524.     wend
  525.  
  526.     loop%=1
  527.     while (loop% and isheader%)
  528.     locate y1%+2,x1%
  529.     color c1%,c2%
  530.     print chr$(lhb%);string$(dwidth%,bmt%);chr$(rhb%);
  531.     loop%=0
  532.     wend
  533.  
  534.     loop%=1
  535.     while (loop% and isheader%=0)
  536.     locate y1%+2,x1%
  537.     color c1%,c2%:print chr$(lrs%);
  538.     color c3%,c4%:print space$(dwidth%);
  539.     color c1%,c2%:print chr$(lrs%);
  540.     loop%=0
  541.     wend
  542.  
  543.     start%=y1%+3                ' body of window
  544.  
  545.     for z%=start% to y2%-1
  546.     locate z%,x1%
  547.  
  548.     if quick% then
  549.         color c1%,c2%:print chr$(lrs%);
  550.         locate z%,x1%+dwidth%+1
  551.         color c1%,c2%:print chr$(lrs%);
  552.     else
  553.         color c1%,c2%:print chr$(lrs%);
  554.         color c3%,c4%:print space$(dwidth%);
  555.         color c1%,c2%:print chr$(lrs%);
  556.     end if
  557.     next z%
  558.  
  559.     color c1%,c2%               ' bottom line
  560.     locate y2%,x1%
  561.     print chr$(llc%);string$(dwidth%,bmt%);chr$(lrc%);
  562.  
  563.     EXIT SUB
  564. END SUB
  565.  
  566. '============================================================================
  567.  
  568. SUB lpt.count (adr%(1),count%) STATIC
  569.  
  570.     count%=0
  571.     offset%=0
  572.  
  573.     def seg=0
  574.     while (peek(&h408+offset%)<>0 and offset%<9)
  575.     adr%(count%)=(peek(&h408+offset%+1)*256)+peek(&h408+offset%)
  576.     count%=count%+1
  577.     offset%=offset%+2
  578.     wend
  579.  
  580.     EXIT SUB
  581. END SUB
  582.  
  583. '============================================================================
  584.  
  585. SUB comm.count (adr%(1),count%) STATIC
  586.  
  587.     count%=0
  588.     offset%=0
  589.  
  590.     def seg=0
  591.     while (peek(&h400+offset%)<>0 and offset%<9)
  592.     def seg=0
  593.     adr%(count%)=(peek(&h400+offset%+1)*256)+peek(&h400+offset%)
  594.     count%=count%+1
  595.     offset%=offset%+2
  596.     def seg=0
  597.     wend
  598.  
  599.     EXIT SUB
  600. END SUB
  601.  
  602. '============================================================================
  603.  
  604. SUB clear.line (l%) STATIC
  605.  
  606.     if (l%>0 and l%<26) then
  607.     color 7,0
  608.     locate l%,1
  609.     print space$(80);
  610.     end if
  611.  
  612.     EXIT SUB
  613. END SUB
  614.  
  615. '============================================================================
  616.  
  617. SUB get.args (c$,arg%,arg$) STATIC
  618.  
  619.     '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  620.     ' Returns argument arg.num% from c.line$ in variable arg$
  621.     '
  622.     ' c$ = command line
  623.     ' arg% = argument number
  624.     ' arg$ = argument returned in this var
  625.     '
  626.     ' routine assumes that at least 1 space separates each argument!
  627.     ' i.e. MENU -C -D -X       where arg 0 = '-C'
  628.     '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  629.  
  630.     ' check for null command line
  631.     if (len(c$)=0) then
  632.         arg%=-1
  633.         arg$=""
  634.         EXIT SUB
  635.     end if
  636.  
  637.     temp.c$=c$
  638.     c$=c$+" "
  639.     count%=0
  640.     start%=1
  641.  
  642.     while (count% <= arg%)
  643.         ' find first non space
  644.         while (mid$(c$,start%,1)=chr$(32))
  645.             start%=start%+1
  646.             if (start%>len(c$)) then
  647.                 arg%=-1
  648.                 arg$=""
  649.                 EXIT SUB
  650.             end if
  651.         wend
  652.  
  653.         ' non space found - search until space found
  654.         i%=instr(start%+1,c$,chr$(32))
  655.         arg$=mid$(c$,start%,i%-start%)
  656.         count%=count%+1
  657.  
  658.         ' update starting position pointer
  659.         start%=i%
  660.     wend
  661.  
  662.     EXIT SUB
  663. END SUB
  664.  
  665. '============================================================================
  666.  
  667. SUB center.text (l%,d$) STATIC
  668.  
  669.     x%=40-int(len(d$)/2)
  670.     locate l%,x%
  671.     print d$
  672.  
  673.     EXIT SUB
  674. END SUB
  675.  
  676. '============================================================================
  677.  
  678. SUB get.day (d$, day$) STATIC
  679.     shared days$()
  680.  
  681.     days$(0)="Sunday"       ' init day names
  682.     days$(1)="Monday"
  683.     days$(2)="Tuesday"
  684.     days$(3)="Wednesday"
  685.     days$(4)="Thursday"
  686.     days$(5)="Friday"
  687.     days$(6)="Saturday"
  688.  
  689.     m%=val(left$(d$,2))     ' month
  690.     d%=val(mid$(d$,4,2))    ' day
  691.     y%=val(right$(d$,4))    ' year
  692.  
  693.     if (m%<3) then
  694.         m%=m%+12
  695.         y%=y%-1
  696.     end if
  697.  
  698.     m%=m%+1
  699.  
  700.     ' calculate day
  701.     j=int(365.25*y%)+(int(30.6001*m%)+d%+(17209.82*100))
  702.     temp=j+1-7*int((j+1)/7)
  703.     e=int(temp+.5)
  704.  
  705.     if (y%>2000) then
  706.         day$=" "
  707.     else
  708.         day$=days$(e)
  709.     end if
  710.  
  711.     EXIT SUB
  712. END SUB
  713.  
  714. '============================================================================
  715.  
  716. SUB real.time (t$, rt$) STATIC
  717.  
  718.     rt$=""
  719.     if (t$<"12:00:00") then
  720.         rt$=t$+" AM"
  721.         EXIT SUB
  722.     end if
  723.  
  724.     if (t$<"13:00:00") then
  725.         rt$=t$+" PM"
  726.     else
  727.         a%=val(left$(t$,2))-12
  728.         a$=str$(a%)
  729.         a$=right$(a$,len(a$)-1)
  730.         a$=string$(2-len(a$),"0")+a$
  731.         rt$=a$+right$(t$,6)+ " PM"
  732.     end if
  733.  
  734.     EXIT SUB
  735. END SUB
  736.  
  737. SUB bios.scroll (d%,yul%,xul%,ylr%,xlr%,n.lines%) STATIC
  738.     shared in.regs%()
  739.     shared out.regs%()
  740.  
  741.     ax%=0           ' CPU REGISTERS
  742.     bx%=1
  743.     cx%=2
  744.     dx%=3
  745.     bp%=4
  746.     si%=5
  747.     di%=6
  748.     fl%=7
  749.  
  750.     '========================= AX =======================================
  751.     ' set AX register to reflect appropriate scroll
  752.     ' which is set by d% (1=up, 0=down)
  753.     if (d%) then
  754.         in.regs%(ax%)=256*7
  755.     else
  756.         in.regs%(ax%)=256*6
  757.     end if
  758.  
  759.     ' adjust AX - set number of lines to scroll
  760.     in.regs%(ax%)=in.regs%(ax%)+n.lines%
  761.  
  762.     '========================= BX =======================================
  763.     in.regs%(bx%)=&h0700
  764.  
  765.     '========================= CX =======================================
  766.     in.regs%(cx%)=(256*yul%)+xul%
  767.  
  768.     '========================= DX =======================================
  769.     in.regs%(dx%)=(256*ylr%)+xlr%
  770.  
  771.     '==================== CALL INT 10H ===============================
  772.     call INT86(&h10,varptr(in.regs%(0)),varptr(out.regs%(0)))
  773.  
  774.     EXIT SUB
  775. END SUB
  776.